home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / load_demos < prev    next >
Encoding:
Text File  |  1994-02-26  |  6.3 KB  |  261 lines
  1. \ Master Demo for JForth
  2. \
  3. \ Run small demos from a menu.
  4. \ Copyright Delta Research - 1986, 1987, 1988
  5. \ Delta Research, Box 1051, San Rafael, CA, 94901
  6. \
  7. \ MOD: PLB 8/6/88 HAM-ART no longer needs its own
  8. \      window for ?terminal.
  9. \ MOD: PLB 1/11/89 Use just one window for hello and message.
  10. \ 00001 16-aug-91 mdh    Fixed phone # (was 485-6867)
  11. \ 00002 16-jan-92 plb/mdh   Added INTUITION? and GRAPHICS? after each demo.
  12.  
  13. decimal
  14.  
  15. verify-libs @  verify-libs off   \ we can do this...this is debugged code!
  16.  
  17. exists? getmodule
  18. .IF
  19.     getmodule includes
  20. .THEN
  21.  
  22. include? boxes jd:demo_boxes
  23. include? curtains jd:demo_scroll
  24. include? task-demo_paint jd:demo_paint
  25. include? menus jd:demo_menus
  26. include? rain  jd:demo_rain
  27. include? ham-art jd:demo_ham
  28. include? demo.speak jd:demo_speak
  29. include? lines jd:demo_lines
  30. include? gsort jd:demo_gsort
  31. include? go.sprite jd:demo_sprite
  32.  
  33.  
  34. ANEW TASK-DEMOS
  35.  
  36. \ Define EZMenu structures.
  37. EZMenu DEMO-MENU
  38.  
  39. \ Example words to execute for menu picks.
  40. VARIABLE ENDDEMO?
  41.  
  42. : EndDemo   ( trigger termination of demo )
  43.     EndDemo? on
  44. ;
  45.  
  46.  
  47. : run-menus  ( -- )
  48.     consoleOUT @
  49.     0" RAW:0/161/400/39/JForth MENU Demo"  (fopen) dup
  50.     IF   dup console!
  51.     THEN menus
  52.     IF   consoleOUT @ fclose
  53.     THEN console!  ;
  54.  
  55. : DEMO-MENU.INIT   ( -- , Setup the structures for demo menu. )
  56.     12 demo-menu ezmenu.alloc    ( allocate space for 12 text menuitems )
  57. \
  58. \ Set links and default values.
  59.     580 menuitem-defwidth !  ( use wider than default menuitems, optional )
  60.     0" Demos" 0 demo-menu ezmenu.setup
  61. \
  62. \ Define text and actions.
  63.     0" HAM ART......hold and modify demo...MANY subtle shades!"
  64.     0 demo-menu ezmenu.text!
  65.     ' ham-art        0 demo-menu ezmenu.cfa[] !
  66. \   ascii H          0 demo-menu ezmenu.commseq!  ( set 'H' commend key )
  67. \
  68.     0" BOXES........draw filled rectangles, REPLACE mode."
  69.     1 demo-menu ezmenu.text!
  70.     ' boxes          1 demo-menu ezmenu.cfa[] !
  71. \
  72.     0" FANCY BOXES..draw filled rectangles, sometimes XOR mode."
  73.     2 demo-menu ezmenu.text!
  74.     ' fancy-boxes    2 demo-menu ezmenu.cfa[] !
  75. \
  76.     0" LINES........fast-moving ... over 500 lines per second!"
  77.     3 demo-menu ezmenu.text!
  78.     ' lines          3 demo-menu ezmenu.cfa[] !
  79. \
  80.     0" CURTAINS.....combination SCROLL and LINES demo."
  81.     4 demo-menu ezmenu.text!
  82.     ' curtains       4 demo-menu ezmenu.cfa[] !
  83. \
  84.     0" RAIN.........'splatters' the screen."
  85.     5 demo-menu ezmenu.text!
  86.     ' rain           5 demo-menu ezmenu.cfa[] !
  87. \
  88.     0" PAINT........track mouse, paint while changing colors."
  89.     6 demo-menu ezmenu.text!
  90.     ' paint          6 demo-menu ezmenu.cfa[] !
  91. \
  92.     0" SPEECH.......interfaces to narrator device."
  93.     7 demo-menu ezmenu.text!
  94.     ' demo.speak     7 demo-menu ezmenu.cfa[] !
  95. \
  96.     0" MENUS........menu interactions: pulldown, check, hilite."
  97.     8 demo-menu ezmenu.text!
  98.     ' run-menus     8 demo-menu ezmenu.cfa[] !
  99. \
  100.     0" SORT.........animated Batcher sort, varies speed."
  101.     9 demo-menu ezmenu.text!
  102.     ' gsort       9 demo-menu ezmenu.cfa[] !
  103. \
  104.     0" SPRITE.......hardware sprite weaves a pattern."
  105.     10 demo-menu ezmenu.text!
  106.         ' GO.SPRITE       10 demo-menu ezmenu.cfa[] !
  107. \
  108.         0" QUIT"
  109.     11 demo-menu ezmenu.text!
  110.         ' EndDemo       11 demo-menu ezmenu.cfa[] !
  111. ;
  112.  
  113. .NEED ErrorCleanup
  114. defer ErrorCleanup
  115. .THEN
  116.  
  117. : DEMO.TERM  ( -- , free memory used )
  118.     ' noop is ErrorCleanup
  119.     gr.closecurw
  120.     demo-menu ezmenu.free
  121.     closealllibs
  122.     gr.term
  123. ;
  124.  
  125. : DO-DEMO-PICK ( class -- done? , process events from IDCMP )
  126.     CASE   ( execute appropriate word for item )
  127.         MENUPICK OF ev-last-code @  demo-menu  ezmenu.exec   false
  128.                 graphics? intuition?  \ because demos close them, 00002
  129.             ENDOF
  130.         CLOSEWINDOW OF true
  131.             ENDOF
  132.             ( other events ) false swap
  133.         ENDCASE
  134. ;
  135.  
  136. variable theDemoWindow  \ store run-time pointer
  137.  
  138. NewWindow DemoWindow   ( Create a template for the new window. )
  139.  
  140. : DEMO.LOOP  ( -- , loop until done )
  141.     EndDemo? off
  142.     BEGIN
  143.         theDemoWindow @  ev.wait
  144.         theDemoWindow @  ev.getclass dup
  145.         IF  theDemoWindow @ ClearMenuStrip()
  146.             do-demo-pick
  147.             theDemoWindow @ gr-curwindow !
  148.             theDemoWindow @ demo-menu SetMenuStrip()
  149.         THEN
  150.         EndDemo? @ OR
  151.     UNTIL
  152. ;
  153.  
  154. \ Graphics version of text I/O
  155. variable LD-YPOS
  156.  
  157. : ?TYPE  ( 0text -- )
  158.     10 ld-ypos @ gr.move
  159.     1- count 1- gr.type
  160. ;
  161.  
  162. : GR.CR
  163.     10 ld-ypos +!
  164. ;
  165.  
  166. : ?SUM  ( 0text csum -- 0text )
  167.     >r  dup 1-   count  ( -- 0text text #chars )  0 swap  0
  168.     DO
  169.         ( -- 0text text csum )  over i + c@ +
  170.     LOOP
  171.     swap drop  ( -- 0text csum )  r> -
  172.     IF
  173.         [ $ 4ef8 w,  4 w, ]
  174.     THEN
  175. ;
  176.  
  177. : ?"   ( -- , <text> )
  178.     >in @ >r
  179.     ascii " lword  count  ( -- text #chars )  0 swap  0
  180.     DO
  181.         ( -- text csum )  over i + c@ +
  182.     LOOP
  183.     swap drop  ( -- csum )
  184.     r> >in !
  185.     [compile] 0"
  186.     [compile] literal
  187.         compile  ?sum
  188. ; immediate
  189.  
  190. : say-hello   ( -- , must open a console window if none there )
  191.     20 ld-ypos !
  192.         1 gr.color!
  193.         ?"    Mike Haas and Phil Burk proudly present these demonstrations"
  194.             ?type gr.cr
  195.         ?" written using the JForth programming language for the Amiga."
  196.             ?type  gr.cr 5 ld-ypos +!
  197.         ?"    JForth offers a COMPLETE Amiga interface, direct compilation"
  198.             ?type gr.cr
  199.         ?" to 68000 machine code, interactive environment, and much more"
  200.             ?type gr.cr
  201.         ?" Our motto ... INTERACT with your Amiga!"
  202.             ?type gr.cr gr.cr
  203.         3 gr.color!
  204.         ?" 'Click' this window to activate the pull down menus..."
  205.             ?type gr.cr gr.cr
  206.         ?" Use close-box or select 'QUIT' from menu to exit..."
  207.             ?type gr.cr gr.cr
  208.         1 gr.color!
  209.         ?" Delta Research, Box 1051, San Rafael, CA, 94915, (415) 453-4320" \ 00001
  210.             ?type
  211. ;
  212.  
  213. : DEMO  ( -- )
  214.     gr.init
  215.     DemoWindow NewWindow.Setup      ( Set defaults for window )
  216.     ?" Delta Research   -=< J F o r t h >=-   Demonstration"
  217.     >abs  DemoWindow ..! nw_title
  218. \
  219. \ Add MENUPICK and ACTIVATE flags to window.
  220.     CLOSEWINDOW MOUSEBUTTONS | MENUPICK |
  221.     DemoWindow ..! nw_idcmpflags
  222.     DemoWindow ..@ nw_flags  ACTIVATE |
  223.     DemoWindow ..! nw_flags
  224.         50 DemoWindow ..! nw_leftedge
  225.         30 DemoWindow ..! nw_topedge
  226.     540 DemoWindow ..! nw_width
  227.     150 DemoWindow ..! nw_height
  228. \
  229. \ Tell Cloned programs to cleanup if an error occurs.
  230.     ' demo.term is ErrorCleanup
  231. \
  232. \ Create window from template and make it the current window.
  233.     DemoWindow gr.opencurw dup theDemoWindow !
  234.     IF  say-hello
  235. \
  236. \ Setup Menus and link to window.
  237.         Demo-menu.init
  238.         theDemoWindow @ demo-menu SetMenuStrip()
  239. \
  240. \ Start looping on events.
  241.         demo.loop
  242. \
  243. \ Cleanup.
  244.         gr-curwindow @ ClearMenuStrip()
  245.         demo.term
  246.     THEN
  247. ;
  248.  
  249. verify-libs !
  250.  
  251. : DEMO.DOC
  252.     >newline cr ." Enter:  DEMO <return>   to start!" cr
  253. ;
  254.  
  255. : AUTO.INIT  ( -- , tell how to start the demos... )
  256.     AUTO.INIT
  257.     demo.doc
  258. ;
  259.  
  260. demo.doc
  261.